home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 22 / Cream of the Crop 22.iso / disk / cluster2.zip / SOURCE.ZIP / VERTMENU.BU < prev   
Text File  |  1996-07-06  |  15KB  |  341 lines
  1. $COMPILE UNIT ".\VERTMENU.PBU"
  2. $CODE SEG "SCRNLIB"
  3. $CPU      8086      ' Make compatible with XT systems
  4. $LIB      ALL OFF   ' Turn off all PowerBASIC libraries
  5. $ERROR    ALL OFF   ' Turn off all PowerBASIC error checking
  6. $OPTIMIZE SIZE      ' Optimize for smaller code
  7.  
  8. DEFINT    A-Z       ' Required for all numeric functions, forces PB to not
  9.                     ' include floating point in UNIT (makes it smaller)
  10.  
  11. '+-----------------------------------------------------------------+
  12. '| This component of PB3BOXES is Copyright Nathan C. Durland III   |
  13. '| All rights reserved                                             |
  14. '+-----------------------------------------------------------------+
  15.  
  16. $INCLUDE ".\PB3BOXES.HDR"
  17.  
  18. SUB VerticalMenu(MenuList$(), Choice%, BYVAL DisplayMode%, _
  19.              BYVAL HighAttr%, BYVAL MenuTimer%,  _
  20.              BYVAL ProcTimer%, BYVAL ProcAddr AS DWORD) LOCAL PUBLIC
  21. '╒════════════════════════════════════════════════════════════════════════════╕
  22. '│ This is the routine to call for simple one-choice vertical menus           │
  23. '│                                                                            │
  24. '│ See TagMenu for a more complete definition of the paramters                │
  25. '╘════════════════════════════════════════════════════════════════════════════╛
  26.  
  27.   Junk$ = "ONE"
  28.     CALL TagMenu(MenuList$(), Junk$, DisplayMode%, _
  29.                   HighAttr%,MenuTimer%, ProcTimer%, ProcAddr)
  30.  
  31.   Choice% = INSTR(junk$,"1")
  32.  
  33. END SUB
  34.  
  35.  
  36. SUB TagMenu(MenuList$(), TagList$, BYVAL DisplayMode%, _
  37.             BYVAL HighAttr%, BYVAL MenuTimeOut%, _
  38.             BYVAL ProcTimeOut%, BYVAL ProcAddr AS DWORD) PUBLIC
  39. '╒════════════════════════════════════════════════════════════════════════════╕
  40. '│ This routine will display a list of items -- MenuList$() -- on the screen  │
  41. '│ and will toggle the corresponding element of TagMenuChoice%() from %True   │
  42. '│ to %False, as appropriate.  Each tagged entry will have a "" next to it.  │
  43. '│                                                                            │
  44. '│ The user can toggle the choice of an item by pressing the INS or the       │
  45. '│ DEL key.  CTRL-INS & CTRL-DEL will select/deselect all items.              │
  46. '│                                                                            │
  47. '│ The ENTER key will terminate the call.  ESC also terminates, but will set  │
  48. '│ the ItemsTagged% parameter to 0.                                           │
  49. '│                                                                            │
  50. '│      - The Home Key will move the menu to the top,                         │
  51. '│      - The End  key will proceed to the bottom.                            │
  52. '╞════════════════════════════════════════════════════════════════════════════╡
  53. '│Using TagMenu really involves 3 CALL statements:                            │
  54. '│    1. call MakeBox to create a box to place the menu in.  Make sure the      │
  55. '│     box is at least 4 characters wider than the widest menu list item.     │
  56. '│    2. call TagMenu.                                                          │
  57. '│    3. call RemoveBox.                                                        │
  58. '╞════════════════════════════════════════════════════════════════════════════╡
  59. '│PowerBASIC calling parameters:                                              │
  60. '│                                                                            │
  61. '│  MenuList$()   --  the items to display on the screen. The last element in │
  62. '│                    the array must be set to ""                             │
  63. '│  TagList$      --  A string of "0" and "1", with a lenght equal to the     │
  64. '│                    number of items in the menu.  "1" corresponds to a      │
  65. '│                    tagged item.  If this string is eqal to "ONE" when this │
  66. '│                    routine is called, then the user will only be allowed   │
  67. '│                    to make one choice.                                     │
  68. '│  DisplayMode%  --  if 0, then the choices are centered in the box.         │
  69. '│                --  if 1, the choices are left justified                    │
  70. '│                --  if 2, the choices are left justified, and have a        │
  71. '│                    letter next to them.  Pressing the letter highlights    │
  72. '│                    that choice. The letters are based on the items position│
  73. '│                    in the menu screen                                      │
  74. '│  HighAttr%     --  The color attribute to use for highlighted items        │
  75. '│  MenuTimeOut%  --  a timeout value (seconds).  If no choice is made before │
  76. '│                    this runs out, the menu exits and returns Choice% = 0.  │
  77. '│                    Set MenuTimer% to 0 for no time out.  A message is      │
  78. '│                    displayed on the bottom of the screen.                  │
  79. '│  ProcTimeOut%  --  Another timer.  This counts how long before the routine │
  80. '│                    pointed to by ProcAddr should be called.  Set it to 0   │
  81. '│                    for no timed routine.  Handy for print spoolers, etc    │
  82. '│  ProcAddr      --  A DWORD value returned by CODEPTR32 that points to a    │
  83. '│                    routine that you'd like done every ProcTimeOut% seconds │
  84. '╘════════════════════════════════════════════════════════════════════════════╛
  85.  
  86.  
  87. JustOne%  = (TagList$ = "ONE")
  88. MenuRow%  = BoxParms%(CurrentBox%,1)    ' Get current box size & paramters
  89. MenuCol%  = BoxParms%(CurrentBox%,2)
  90. MenuRows% = BoxParms%(CurrentBox%,3)
  91. MenuCols% = BoxParms%(CurrentBox%,4)
  92. MenuAttr% = BoxParms%(CurrentBox%,5)
  93.  
  94. '╒════════════════════════════════════════════════════════════════╕
  95. '│ We're might have to change these, so we want to save them now  │
  96. '╘════════════════════════════════════════════════════════════════╛
  97. OldMenuCol%   = MenuCol%
  98. OldMenuRows%  = MenuRows%
  99. OldMenuCols%  = MenuCols%
  100.  
  101. IF BoxParms%(CurrentBox%,6) > 0 THEN    ' Account for the border
  102.   INCR MenuRow%,1
  103.   DECR MenuRows%,2
  104.   INCR MenuCol%,1
  105.   DECR MenuCols%,2
  106. END IF
  107.  
  108. MenuLen% = MenuRows%                        ' set some other vars that we need
  109. ARRAY SCAN MenuList$(1), = "", TO ItemCnt%
  110. IF ItemCnt% = 0 THEN
  111.   ItemCnt% = UBOUND(MenuList$())
  112. ELSE
  113.   DECR ItemCnt%,1
  114. END IF
  115.  
  116. IF ItemCnt% < MenuLen% THEN
  117.   MenuLen% = ItemCnt%
  118.   MenuRows% = ItemCnt%
  119.   BoxParams%(CurrentBox%,3) = ItemCnt% + 2  ' set this so that only the area
  120. END IF                                      ' with menu items on it scrolls
  121.  
  122. IF DisplayMode% = 2 THEN                    ' put the letters in place for
  123.   FOR x% = 1 TO MenuLen%                    ' the menu
  124.     CALL PrtBox(x%,1,CHR$(64+x%,32),HighAttr%)
  125.   NEXT x%
  126.   BoxParms%(CurrentBox%,2) = MenuCol% + 1
  127.   BoxParms%(CurrentBox%,4) = MenuCol% - 1  ' change this so letters don't
  128.   MenuCol% = MenuCol% + 2                   ' scroll with box
  129.   MenuCols% = MenuCols% - 2
  130. END IF
  131.  
  132. TagList$ = TagList$ + STRING$(ItemCnt%,"0")
  133. TagList$ = LEFT$(TagList$,ItemCnt%)
  134.  
  135. ItemPtr% = 1                          'Array member currently pointed to
  136. curntpos% = 1                          'Position in the on-screen menu
  137. TheCnt% = ItemsTagged%
  138. TopItem% = 1
  139. BottomItem% = MenuLen%
  140.  
  141. GOSUB FillTagMenu
  142. MenuTimer! = -1
  143. ProcTimer! = -1
  144. IF MenuTimeOut% > 0 THEN MenuTimer! = TIMER + MenuTimeOut%
  145. IF ProcTimeOut% > 0 THEN ProcTimer! = TIMER + ProcTimeOut%
  146. Terminated% = %False
  147. WHILE NOT Terminated%
  148.  
  149. ' Highlight the current item
  150.   CALL QATTR((MenuRow%+curntPos%-1), MenuCol%,1, MenuCols%, HighAttr%)
  151.  
  152. ' Get a keypress from the user, and do other stuff while we are waiting
  153.     WHILE NOT INSTAT
  154.     IF (MenuTimer! > 0) AND (TIMER > MenuTimer!) THEN
  155.       TagList$ = STRING$(ItemCnt%,"0")
  156.       EXIT SUB
  157.     END IF
  158.  
  159.     IF (ProcTimer! > 0) AND (TIMER > ProcTimer!) THEN
  160.       CALL DWORD ProcAddr
  161.       ProcTimer! = TIMER + ProcTimeOut%
  162.     END IF
  163.   WEND
  164.  
  165.   a$ = INKEY$                             ' get the key, then
  166.   IF LEN(a$) = 1 THEN                     ' assign the ascii value to
  167.     ans% = ASC(UCASE$(a$))                ' our response.
  168.   ELSE                                    ' for two byte keys, response is
  169.     ans% = 255 + ASC(RIGHT$(a$,1))        ' 255 + the ascii value of
  170.   END IF                                  ' the second byte
  171.  
  172.   IF MenuTimeOut% > 0 THEN MenuTimer! = TIMER + MenuTimeOut%
  173.   IF ProcTimeOut% > 0 THEN ProcTimer! = TIMER + ProcTimeOut%
  174.  
  175.     IF JustOne% THEN                          ' When choosing just one item, we
  176.         IF ans% = %Space   THEN ans% = 0   ' ignore space, plus, minus
  177.         IF ans% = %InsKey  THEN ans% = 0   ' ctrl+ and ctrl-
  178.         IF ans% = %DelKey  THEN ans% = 0
  179.         IF ans% = %CtrlIns THEN ans% = 0
  180.         IF ans% = %CtrlDel THEN ans% = 0
  181.     END IF
  182.     IF Ans% = 0 THEN ITERATE
  183.  
  184. 'We've got a key press, so Un-highlight the current item
  185.   CALL QATTR((MenuRow%+curntPos%-1), MenuCol%,1, MenuCols%, MenuAttr%)
  186.     IF MID$(TagList$,ItemPtr%,1) = "1" THEN CALL PrtBox(curntpos%,1,"",HighAttr%)
  187.  
  188. ' Now process the keystroke.
  189.  
  190.   IF ans% = %Enter THEN                       ' we're done, get out
  191.       Terminated% = %True
  192.     IF JustOne% THEN
  193.       MID$(TagList$,ItemPtr%,1) = "1"
  194.     ELSE
  195.       ItemsTagged% = TALLY(TagList$,"1")
  196.       IF ItemsTagged% = 0 THEN MID$(TagList$,ItemPtr%,1) = "1"
  197.     END IF
  198.     ELSEIF ans% = %Esc THEN                     ' We're abandoning.
  199.     TagList$ = STRING$(ItemCnt%,"0")
  200.       Terminated% = %True
  201.   ELSEIF (ans% = %DelKey) OR _                ' del or minus untags
  202.          (ans% = ASC("-")) THEN
  203.     MID$(TagList$,ItemPtr%,1) = "0"
  204.     CALL PrtBox(curntpos%,1," ",-1)
  205.     IF (ItemPtr% < ItemCnt%) AND _            ' and go to next item
  206.            (curntpos% < MenuLen%) THEN
  207.       INCR curntpos%, 1
  208.       INCR ItemPtr%, 1
  209.         END IF
  210.   ELSEIF (ans% = %InsKey) OR _                ' insert or Plus tags
  211.          (ans% = ASC("+")) THEN
  212.     MID$(TagList$,ItemPtr%,1) = "1"
  213.     CALL PrtBox(curntpos%,1,"",HighAttr%)
  214.     IF (ItemPtr% < ItemCnt%) AND _            ' and go to next item
  215.            (curntpos% < MenuLen%) THEN
  216.       INCR curntpos%, 1
  217.       INCR ItemPtr%, 1
  218.         END IF
  219.   ELSEIF ans% = %Space THEN                   ' Space is a toggle
  220.     a$ = MID$(TagList$,ItemPtr%,1)
  221.     IF a$ = "0" THEN
  222.       MID$(TagList$,ItemPtr%,1) = "1"
  223.       CALL PrtBox(curntpos%,1,"",HighAttr%)
  224.     ELSE
  225.       MID$(TagList$,ItemPtr%,1) = "0"
  226.       CALL PrtBox(curntpos%,1," ",MenuAttr%)
  227.     END IF
  228.     IF (ItemPtr% < ItemCnt%) AND _            ' and go to next item
  229.            (curntpos% < MenuLen%) THEN
  230.       INCR curntpos%, 1
  231.       INCR ItemPtr%, 1
  232.         END IF
  233.   ELSEIF ans% = %PgUp THEN                    ' page up
  234.     IF TopItem% > 1 Then
  235.       TopItem% = TopItem% - MenuLen%
  236.       IF TopItem% < 1 THEN TopItem% = 1
  237.       BottomItem% = TopItem% + MenuLen%
  238.       ItemPtr% = TopItem%
  239.       curntpos% = 1
  240.       GOSUB FillTagMenu
  241.     END IF
  242.   ELSEIF ans% = %PgDn THEN                    ' page down
  243.     IF BottomItem% < ItemCnt% Then
  244.       BottomItem% = BottomItem% + MenuLen% + 1
  245.       IF BottomItem% > ItemCnt% THEN BottomItem% = ItemCnt% + 1
  246.       TopItem% = BottomItem% - MenuLen%
  247.       ItemPtr% = TopItem%
  248.       curntpos% = 1
  249.       GOSUB FillTagMenu
  250.     END IF
  251.   ELSEIF ans% = %UpArrow THEN                 ' go up one item
  252.     IF curntpos% > 1 THEN                     ' not at top, so it's easy
  253.       DECR curntpos%, 1
  254.       DECR ItemPtr%, 1
  255.     ELSEIF ItemPtr% > 1 THEN                  'if we aren't at the first item
  256.       CALL ScrollBox(0,1)                     ' scroll the box down
  257.       DECR ItemPtr%,1                         ' and adjust the pointers
  258.       DECR TopItem%,1                         ' the line will get redisplayed
  259.       DECR BottomItem%,1                      ' at the top of the loop
  260.           IF DisplayMode% = 0 THEN                      ' center the item
  261.             CALL PrtBox(curntpos%,0,MenuList$(ItemPtr%),-1)
  262.           ELSE                                          ' left justify
  263.             CALL PrtBox(curntpos%,2,MenuList$(ItemPtr%),-1)
  264.           END IF
  265.           IF MID$(TagList$,ItemPtr%,1) = "1" THEN CALL PrtBox(curntpos%,1,"",HighAttr%)
  266.     END IF
  267.   ELSEIF ans% = %DownArrow THEN               ' go down an item
  268.     IF curntpos% < MenuLen%  THEN             ' not at bottom, so it's easy
  269.       INCR curntpos%, 1
  270.       INCR ItemPtr%, 1
  271.     ELSEIF ItemPtr% < ItemCnt% THEN           'if this isn't the last item
  272.       CALL ScrollBox(1,1)                     ' Scroll the box up, and adjust
  273.       INCR ItemPtr%,1                         ' the pointers.  The line will
  274.       INCR TopItem%,1                         ' redisplay at the top of the
  275.       INCR BottomItem%,1                      ' keyin loop
  276.           IF DisplayMode% = 0 THEN                      ' center the item
  277.             CALL PrtBox(curntpos%,0,MenuList$(ItemPtr%),-1)
  278.           ELSE                                          ' left justify
  279.             CALL PrtBox(curntpos%,2,MenuList$(ItemPtr%),-1)
  280.           END IF
  281.           IF MID$(TagList$,ItemPtr%,1) = "1" THEN CALL PrtBox(curntpos%,1,"",HighAttr%)
  282.     END IF
  283.   ELSEIF ans% = %HomeKey THEN                 ' go to top of item list
  284.     ItemPtr% = 1
  285.     curntpos% = 1
  286.     TopItem% = 1
  287.     BottomItem% = TopItem% + MenuLen%
  288.     GOSUB FillTagMenu
  289.   ELSEIF ans% = %EndKey THEN                  ' go to bottom of item list
  290.     ItemPtr% = ItemCnt%
  291.     curntpos% = MenuLen%
  292.     BottomItem% = ItemCnt%
  293.     TopItem% = BottomItem% - MenuLen%
  294.     GOSUB FillTagMenu
  295.   ELSEIF ans% = %CtrlDel THEN                 ' Untag everything
  296.     TagList$ = STRING$(ItemCnt%,"0")
  297.     GOSUB FillTagMenu
  298.   ELSEIF ans% = %CtrlIns THEN                 ' tag everything
  299.     TagList$ = STRING$(ItemCnt%,"1")
  300.     GOSUB FillTagMenu
  301.   ELSE
  302.     IF (ans% > 64) AND (ans% < 91) THEN
  303.       a% = TopItem% + (ans% - 65)
  304.       MID$(TagList$,a%,1) = "1"
  305.       IF JustOne% THEN Terminated% = %True
  306.       curntpos% = a%
  307.     END IF
  308.     END IF
  309.  
  310. WEND
  311. BoxParms%(CurrentBox%,2) = OldMenuCol%
  312. BoxParms%(CurrentBox%,3) = OldMenuRows%
  313. BoxParms%(CurrentBox%,4) = OldMenuCols%
  314.  
  315. EXIT SUB    'Good bye!
  316.  
  317.  
  318. FillTagMenu:
  319. '╒═════════════════════════════════════════════════════════════════════════╕
  320. '│This sub fills the empty box with menu items, based on the current value │
  321. '│of ItemPtr% and MenuLen%                                                 │
  322. '╘═════════════════════════════════════════════════════════════════════════╛
  323. IF TopItem% < 1 THEN TopItem% = 1
  324. BottomItem% = TopItem% + MenuLen% - 1
  325. IF BottomItem% > ItemCnt% THEN BottomItem% = ItemCnt%
  326.  
  327. CALL ClearBox(-1,-1)
  328. FOR ThisItem% = TopItem% to BottomItem%
  329.   x% = ThisItem% - TopItem% + 1
  330.   IF DisplayMode% = 0 THEN                                ' center the item
  331.     CALL PrtBox(x%,0,MenuList$(ThisItem%),-1)
  332.   ELSE                                                    ' left justify
  333.     CALL PrtBox(x%,2,MenuList$(ThisItem%),-1)
  334.   END IF
  335.   IF MID$(TagList$,ThisItem%,1) = "1" THEN CALL PrtBox(x%,1,"",HighAttr%)
  336. NEXT ThisItem%
  337.  
  338. RETURN
  339.  
  340. END SUB
  341.